perm filename LOOPX.FAI[P11,LCS] blob sn#590687 filedate 1981-05-28 generic text, type T, neo UTF8
00100		TITLE LOOPX
00200		ENTRY DPYNEW,FSCAN,BOX,dpydo
00300	
00400		EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL
00500		EXTERNAL RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,LIMIT,IDEV,DDCLR
00600		EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE,DPTR,DPYX
00700		EXTERNAL LOOP
00800	A←6 ↔K←7↔ R←12↔ L←13   
00900	;**** AC'S 0,1,2,3,5  ARE USED IN 'PLACE' & 'FINDIT'!!
01000	
01100	DPYNEW:	0    ;	SUBROUTINE DPYNEW
01200		JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
01300		JUMP	[1]    ;	CALL ACCPOG(1)
01400		MOVE	2,DPY+=4001    ;	IF(IGO.GT.0)RETURN
01500		JUMPG	2,DB    ;	CALL DPYOUT(1)
01600		JSA	16,DPYDO     ;	END
01700	  	JUMP	[1]
01800	DB:	JRA	16,(16)
01900	
02000	FSCAN:	0
02100		INCHRW
02200		MOVE 2,[ASCII/     /]
02300		MOVEM 2,ALF
02400		MOVE 2,[XWD ALF,ALF+1]
02500		BLT 2,ALF+=71			; CLEANS OUT INP ARRAY
02600		CAIN ";"
02700		JRA 16,(16)
02800		CAIN ":"
02900		JRA 16,1(16)
03000		CAIN "("
03100		JRA 16,2(16)
03200		CAIN ")"
03300		JRA 16,3(16)
03400		CAIN "/"
03500		JRA 16,4(16)
03600		CAIN "*"
03700		JRA 16,5(16)
03800		CAIN "X"
03900		JRA 16,6(16)
04000		CAIN "C"
04100		JRA 16,7(16)
04200		JRA 16,8(16)
04300	
04400	
04500	BOX:	0    	;CALL BOX(I,R)   SEE PLTSRT.F4 FOR FORTR. VERSION
04600		MOVE IDEV
04700		CAIE 5
04800		JRST BX4-3	;UPDATE IOLD    JRA 16,2(16)	;IF(IDEV.NE.5)RETURN
04900	     	MOVE 14,@(16)	; I IS IN 14
05000		JUMPL 14,BX4
05100		KIFIX 13,@1(16)	;K=R	;MOVE 13,@1(16)	; GET R
05200		JSA 16,AMOD
05300		JUMP XRN+3(14)	; GET REAL P4
05400		[100.0]
05500		CAMGE [-20.0]	;IF(P4.LT.-20)P4=P4+100
05600		FADR [100.0]	; FOR P4=-95 ETC.
05700		CAML [80.0]	;IF(P4.GE.80)P4=P4-100
05800		FSBR [100.0]	; CATCHES NEG. MINIS, ETC.
05900		FMPR [7.0]
06000		FMPR STF(13)	;*STAFF FACTOR
06100		FADR POSI(13)	; + STAFF VERT. POS.
06200		FSBR [40.0]	;  SHIFT CURSOR DOWN A BIT.
06300		FMPR SIZ
06400		KIFIX 13,0	
06500		SUB 13,SIZ+2	;13=K
06600		JSA 16,RHORZ	; GET HORIZ. POS.
06700		JUMP XRN+2(14)
06800		FMPR SIZ	;SIZ IS FOR ZOOMED IMAGES
06900		KIFIX 12,0		;MOVE 12,	;  12=L
07000		SUB 12,SIZ+1
07100		CAIL 12,=550	; CHECK IF OUT OF BOUNDS OF CRT
07200		MOVEI 12,=511
07300		CAMG 12,[-=550]
07400		MOVE 12,[-=511]
07500	DDCHK:	MOVNI	2,1
07600		GETLIN	2	;0=IT IS A DD
07700		TLNN	2,20000    ;	-1=NOT DD
07800		JRST NOTDD
07900	;;	JSA 16,DDCLR	
08000	;;	JSA 16,DPYSET
08100	;;	[3]		;MAKE A CURSOR ON DATADISC
08200	;;	RINP
08300	;;	[=100]
08400		MOVE 14,DPY+1	;GET DPY WDCNT
08500		MOVE 12
08600		SUBI 20
08700		MOVEM X1#
08800		ADDI 40
08900		MOVEM X2#
09000		MOVE 13
09100		SUBI 20
09200		MOVEM Y1#
09300		ADDI 40
09400		MOVEM Y2#
09500	;;	JSA 16,SETPOG
09600	;;	[3]
09700		JSA 16,ALINE
09800		JUMP X1
09900		JUMP Y1
10000		JUMP X2
10100		JUMP Y2
10200		JSA 16,ALINE
10300		JUMP X1
10400		JUMP Y2
10500		JUMP X2
10600		JUMP Y1
10700	;;	JSA 16,DPYDO
10800	;;	[3]
10900	;;	JSA 16,SETPOG
11000	;;	[1]
11100		JSA 16,DPYDO
11200		[1]
11300		MOVEM 14,DPY+1	;PUT BACK DPY WDCNT.
11400		JRST BX4-3	;JRA 16,2(16)	;MAKE AN X ON THE DATA DISC
11500	NOTDD:	JSA 16,SETCUR
11600		12
11700		13
11800		[0]
11900		MOVE DL		;IOLD=X22   FOR TYPING "I <CR>" TO GET LAST EDIT BACK.
12000		MOVEM DL+4
12100		JRA 16,2(16)	; THE CURSOR IS IN POSITION
12200	BX4:	CAME 14,[-1]
12300		JRST BX5
12400		JSA 16,DPYSET
12500		[3]
12600		RINP
12700		[=100]
12800		JSA 16,DPYBRT
12900		[3]
13000	BX5:	MOVE 2,@1(16)	; GET R
13100		JSA 16,RHORZ
13200		2
13300		FMPR SIZ
13400		KIFIX 0,0
13500		SUB SIZ+1
13600		MOVM 2,
13700		CAILE 2,=550
13800		JRST BX6
13900		MOVEM 0,ALZ#
14000		JSA 16,SETPOG
14100		[3]
14200		JSA 16,ALINE
14300		JUMP ALZ 
14400		[-=511]
14500		JUMP ALZ
14600		[=511]
14700		JSA 16,DPYOUT
14800		[3]
14900	BX6:	JSA 16,SETPOG
15000		[1]
15100		JRA 16,2(16)
15200	
15300	
20500	DPYDO:	0		;CALL DPYDO(N)
20600	
20700		MOVE  0,@(16)
20800		MOVEM 0,ALZ
20900		CAIN 0,1	;DON'T CLEAR IF NOT PIECE OF GLASS #1
21000		MOVNI	2,1	;			**
21100		GETLIN	2	;0=IT IS A DD		**
21200		TLNE	2,20000    ;	0=IS DD		**
21300		JSA 16,DDCLR     ; GO CLEAR THE DD SCREEN 
21400		JSA 16,DPYOUT
21500		JUMP ALZ
21600		JRA 16,1(16)		; 	RETURN
21700		END